// $Id: Serial.pas 89 2006-11-11 18:53:46Z alpov $

unit Serial;

interface

uses
  Windows;

function OpenCom(Com: string; BaudRate: Integer): Boolean;
procedure CloseCom;
function WriteCom(const Buffer; Length: Word): Boolean;
function ReadCom(var Buffer; Length: Word): Boolean;
function WaitingOnCom: Integer;
procedure FlushInputCom;

implementation

var
  FComHandle: THandle;

function OpenCom(Com: string; BaudRate: Integer): Boolean;
var
  DCB: TDCB;
  COMMTIMEOUTS: TCOMMTIMEOUTS;
begin
  Result := False;
  FComHandle := CreateFile(PChar(Com), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0);
  if FComHandle = INVALID_HANDLE_VALUE then Exit;
  if not SetupComm(FComHandle, 8192, 8192) then begin
    CloseHandle(FComHandle);
    Exit;
  end;
  if not GetCommState(FComHandle, DCB) then begin
    CloseHandle(FComHandle);
    Exit;
  end;
  DCB.BaudRate := BaudRate;
  DCB.ByteSize := 8;
  DCB.Parity := NOPARITY;
  DCB.StopBits := ONESTOPBIT;
  if not SetCommState(FComHandle, DCB) then begin
    CloseHandle(FComHandle);
    Exit;
  end;
  with COMMTIMEOUTS do begin
    ReadIntervalTimeout := 0;
    ReadTotalTimeoutMultiplier := 1;
    ReadTotalTimeoutConstant := 500;
    WriteTotalTimeoutMultiplier := 0;
    WriteTotalTimeoutConstant := 0;
  end;
  if not SetCommTimeouts(FComHandle, COMMTIMEOUTS) then begin
    CloseHandle(FComHandle);
    Exit;
  end;
  Result := True;
end;

procedure CloseCom;
begin
  CloseHandle(FComHandle);
end;

function WriteCom(const Buffer; Length: Word): Boolean;
var
  BytesWritten: Cardinal;
begin
  Result := False;
  if not WriteFile(FComHandle, Buffer, Length, BytesWritten, nil) then Exit;
  if BytesWritten = Length then Result := True;
end;

function ReadCom(var Buffer; Length: Word): Boolean;
var
  BytesRead: Cardinal;
begin
  Result := False;
  if not ReadFile(FComHandle, Buffer, Length, BytesRead, nil) then Exit;
  if BytesRead = Length then Result := True;
end;

function WaitingOnCom: Integer;
var
  Stat: TComStat;
  Error: Cardinal;
begin
  Result := -1;
  if not ClearCommError(FComHandle, Error, @Stat) then Exit;
  Result := Stat.cbInQue;
end;

procedure FlushInputCom;
var
  Len: Integer;
  Buffer: array[0..127] of Byte;
begin
  Len := WaitingOnCom;
  while (Len > 0) do begin
    if Len > SizeOf(Buffer) then Len := SizeOf(Buffer);
    ReadCom(Buffer, Len);
    Len := WaitingOnCom;
  end;
end;

end.
